home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
ProjectOberon
/
Types.mod
< prev
next >
Wrap
Text File
|
1995-07-02
|
3KB
|
118 lines
(*************************************************************************
$RCSfile: Types.mod $
Description: Clone of the Project Oberon Types module.
Created by: fjc (Frank Copeland)
$Revision: 1.1 $
$Author: fjc $
$Date: 1995/02/21 13:50:23 $
Copyright © 1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
*************************************************************************)
<* STANDARD- *>
MODULE Types;
IMPORT SYS := SYSTEM, Kernel, Modules;
TYPE
Type *= POINTER TO TypeDesc;
TypeDesc *= RECORD
name *: ARRAY 32 OF CHAR;
module *: Modules.Module;
next : Type;
tag : SYS.TYPETAG;
END; (* TypeDesc *)
VAR
TypList : Type;
PROCEDURE FindType ( tag : SYS.TYPETAG ) : Type;
VAR
module : Kernel.Module; type : Kernel.Type; t : Type;
name : ARRAY 80 OF CHAR; modName, typName : ARRAY 32 OF CHAR;
i, j : INTEGER;
BEGIN (* FindType *)
t := TypList; WHILE (t # NIL) & (t.tag # tag) DO t := t.next END;
IF t = NIL THEN
Kernel.Name (tag, name);
IF name # "" THEN
i := 0; WHILE name[i] # '.' DO modName[i] := name[i]; INC (i) END;
modName[i] := 0X;
INC (i); j := 0;
REPEAT typName[j] := name[i]; INC (i); INC (j) UNTIL name[i] = 0X;
module := Kernel.FindModule (modName);
IF module # NIL THEN
type := Kernel.FindType (module, typName);
IF type # NIL THEN
NEW (t); COPY (typName, t.name);
t.module := Modules.ThisMod(modName);
t.tag := tag; t.next := TypList; TypList := t;
END
END
END
END;
RETURN t
END FindType;
PROCEDURE BaseOf* ( t : Type; level : INTEGER ) : Type;
BEGIN (* BaseOf *)
RETURN FindType (Kernel.BaseOf (t.tag, level))
END BaseOf;
PROCEDURE LevelOf* ( t : Type ) : INTEGER;
BEGIN (* LevelOf *)
RETURN Kernel.LevelOf (t.tag)
END LevelOf;
PROCEDURE NewObj* ( VAR o : SYS.PTR; t : Type );
VAR type : Kernel.Type;
BEGIN (* NewObj *)
o := NIL;
type := Kernel.FindType (Kernel.FindModule (t.module.name), t.name);
IF type # NIL THEN Kernel.New (o, type.tag) END
END NewObj;
PROCEDURE This* ( mod : Modules.Module; name : ARRAY OF CHAR ) : Type;
VAR module : Kernel.Module; type : Kernel.Type; t : Type;
<*$ClearVars-*>
BEGIN (* This *)
t := NIL; module := Kernel.FindModule (mod.name);
IF module # NIL THEN
type := Kernel.FindType (module, name);
IF type # NIL THEN
NEW (t); COPY (name, t.name);
t.module := mod; t.tag := type.tag;
t.next := TypList; TypList := t
END
END;
RETURN t
END This;
PROCEDURE TypeOf* ( o : SYS.PTR ) : Type;
BEGIN (* TypeOf *)
RETURN FindType (SYS.TAG (o))
END TypeOf;
END Types.